home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tvspy.zip / EVENTWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-17  |  10KB  |  376 lines
  1. unit eventwin;
  2.  
  3. {********************************************************}
  4. { Event watching window for Turbo Vision applications.   }
  5. { Copyright (c) 1990 by Danny Thorpe                     }
  6. {********************************************************}
  7.  
  8. {$X+}  { allow function results to be ignored }
  9.  
  10. interface
  11.  
  12. uses objects, drivers, views, menus, dialogs, keynamer, textwin;
  13.  
  14.  
  15. type
  16.        PCommandRec = ^TCommandRec;
  17.        TCommandRec = record
  18.          command: word;
  19.          description: string[80];
  20.          end;
  21.  
  22.        PCommandCollection = ^TCommandCollection;
  23.        TCommandCollection = object(TSortedCollection)
  24.          function Compare( Key1, Key2: pointer): integer; virtual;
  25.          function Keyof( Item: pointer): pointer;  virtual;
  26.          procedure FreeItem( Item: pointer);  virtual;
  27.          end;
  28.  
  29.  
  30.        PEWMenubar = ^TEWMenubar;
  31.        TEWMenubar = object(TMenubar)
  32.          function GetPalette: PPalette;         virtual;
  33.          function NewSubView(var Bounds: TRect; AMenu: PMenu;
  34.            AParentMenu: PMenuView): PMenuView; virtual;
  35.          end;
  36.  
  37.  
  38.        PEWMenubox = ^TEWMenubox;
  39.        TEWMenubox = object(TMenubox)
  40.          function GetPalette: PPalette;         virtual;
  41.          end;
  42.  
  43.  
  44.        PEventWindow = ^TEventWindow;
  45.        TEventWindow = object(TTextWindow)
  46.          CommandList: TCommandCollection;
  47.          Filters: word;
  48.          constructor Init( var R: TRect; ATitle: string; Num, MaxLines: integer);
  49.          destructor  Done;  virtual;
  50.          procedure DisplayEvent( var Event: TEvent); virtual;
  51.          function  GetPalette: PPalette;             virtual;
  52.          procedure InsertCommand(ACommand: word; ADescription: string); virtual;
  53.          procedure HandleEvent(var Event: TEvent);   virtual;
  54.          procedure MakeInterior( Maxlines: integer); virtual;
  55.          procedure FiltersDialog;
  56.          end;
  57.  
  58.  
  59. var EventWindow: PEventWindow;
  60.  
  61.  
  62.  
  63. { This message function will override Views.Message, if this unit is listed
  64.   after Views in your source code's uses statement.
  65. }
  66.  
  67. function Message( Receiver: PView; What, Command: word; InfoPtr: Pointer): pointer;
  68.  
  69.  
  70.  
  71.  
  72. implementation
  73.  
  74. const
  75.  
  76.   cmEventFilters = 503;
  77.  
  78.   CEWMenu = #9#10#11#12#13#14;
  79.  
  80.  
  81. function TCommandCollection.Compare( Key1, Key2: pointer): integer;
  82.   begin
  83.   if word(Key1^) < word(Key2^) then
  84.     Compare := -1
  85.   else if word(Key1^) > word(Key2^) then
  86.     Compare := 1
  87.   else
  88.     Compare := 0;
  89.   end;
  90.  
  91.  
  92. function TCommandCollection.KeyOf( Item: pointer): pointer;
  93.   begin
  94.   KeyOf := @PCommandRec(Item)^.Command;
  95.   end;
  96.  
  97.  
  98. procedure TCommandCollection.FreeItem( Item: pointer);
  99.   begin
  100.   if Item <> nil then  Dispose(Item);
  101.   end;
  102.  
  103.  
  104.  
  105.  
  106. function TEWMenubar.GetPalette: PPalette;
  107.   const P: string[length(CEWMenu)] = CEWMenu;
  108.   begin
  109.   GetPalette:= @P;
  110.   end;
  111.  
  112.  
  113. function TEWMenubar.NewSubView(var Bounds: TRect; AMenu: PMenu;
  114.            AParentMenu: PMenuView): PMenuView;
  115.   begin
  116.   NewSubView := New(PEWMenuBox, Init(Bounds, AMenu, AParentMenu));
  117.   end;
  118.  
  119.  
  120. function TEWMenubox.GetPalette: PPalette;
  121.   const P: string[length(CEWMenu)] = CEWMenu;
  122.   begin
  123.   GetPalette:= @P;
  124.   end;
  125.  
  126.  
  127.  
  128. constructor TEventWindow.Init( var R: TRect;
  129.                                ATitle: string;
  130.                                Num, Maxlines: integer);
  131.   begin
  132.   TTextWindow.Init( R, ATitle, Num, MaxLines);
  133.   Flags := Flags and not (wfClose or wfZoom);
  134.   Filters := evMouse or evKeyBoard or evMessage;
  135.   CommandList.Init( 5,1);
  136.   end;
  137.  
  138.  
  139.  
  140. destructor TEventWindow.Done;
  141.   begin
  142.   CommandList.Done;
  143.   TTextWindow.Done;
  144.   end;
  145.  
  146.  
  147.  
  148. procedure TEventWindow.DisplayEvent( var Event: TEvent);
  149.   var st,xs,ys: string;
  150.       index: integer;
  151.       E: TEvent;
  152.   begin
  153.   st:='';
  154.   if ((State and sfSelected) = 0) then
  155.     { don't log messages when we're selected }
  156.     begin
  157.     E := Event;
  158.     { if Filter bit isn't set, then don't log it }
  159.     E.What := E.What and Filters;
  160.     case E.What of
  161.       evNothing  : exit;
  162.       evMouseDown,
  163.       evMouseUp,
  164.       evMouseMove,
  165.       evMouseAuto: begin
  166.                    st:='Mouse ';
  167.                    case E.What of
  168.                      evMouseDown: st:= st+ 'Down, ';
  169.                      evMouseUp  : st:= st+ 'Up, ';
  170.                      evMouseMove: st:= st+ 'Move, ';
  171.                      evMouseAuto: st:= st+ 'Auto, ';
  172.                      end;
  173.                    case E.Buttons of
  174.                      mbLeftButton : st:= st+'Left Button, ';
  175.                      mbRightButton: st:= st+'Right Button, ';
  176.                      $04          : st:= st+'Center Button, ';
  177.                      end;
  178.                    if (E.Buttons <> 0) and E.Double then
  179.                      st:= st+'Double Click ';
  180.                    str(E.Where.X:0,xs);
  181.                    str(E.Where.Y:0,ys);
  182.                    st:= st+'X:'+xs+' Y:'+ys;
  183.                    end;
  184.       evKeyDown  : begin
  185.                    st:= KeyName(E.KeyCode);
  186.                    if length(st)=0 then
  187.                      st:= KeyName(word(E.CharCode));
  188.                    st:= 'Keyboard '+st;
  189.                    end;
  190.       evCommand,
  191.       evBroadcast: begin
  192.                    if E.What = evCommand then
  193.                      st:='Command '
  194.                    else
  195.                      st:='Broadcast ';
  196.                    case E.Command of
  197.                      cmQuit  : st:= st+'cmQuit';
  198.                      cmError : st:= st+'cmError';
  199.                      cmMenu  : st:= st+'cmMenu';
  200.                      cmClose : st:= st+'cmClose';
  201.                      cmZoom  : st:= st+'cmZoom';
  202.                      cmResize: st:= st+'cmResize';
  203.                      cmNext  : st:= st+'cmNext';
  204.  
  205.                      cmOk    : st:= st+'cmOk';
  206.                      cmCancel: st:= st+'cmCancel';
  207.                      cmYes   : st:= st+'cmYes';
  208.                      cmNo    : st:= st+'cmNo';
  209.                      cmDefault:st:= st+'cmDefault';
  210.  
  211.                      cmReceivedFocus    : st:= st+'cmReceivedFocus';
  212.                      cmReleasedFocus    : st:= st+'cmReleasedFocus';
  213.                      cmCommandSetChanged: st:= st+'cmCommandSetChanged';
  214.                      cmScrollBarChanged : st:= st+'cmScrollBarChanged';
  215.                      cmScrollBarClicked : st:= st+'cmScrollBarClicked';
  216.                      cmSelectWindowNum  : st:= st+'cmSelectWindowNum';
  217.                      else
  218.                        begin
  219.                        index:=0;
  220.                        if CommandList.Search(@E.Command, index) then
  221.                          begin
  222.                          st:= st+ PCommandRec(CommandList.At(index))^.Description;
  223.                          end
  224.                        else
  225.                          begin
  226.                          str(E.Command:0, xs);
  227.                          st:= st+'unknown: '+xs;
  228.                          end;
  229.                        end;
  230.                      end;
  231.                    end;
  232.       else
  233.         begin
  234.         str(E.What:0, xs);
  235.         st:= 'Unknown Event.What: '+xs;
  236.         end;
  237.       end;  {case}
  238.  
  239.     Interior^.Append(NewStr(st));
  240.     end;  { if }
  241.   end;
  242.  
  243.  
  244.  
  245.  
  246.  
  247. function TEventWindow.GetPalette: PPalette;
  248.   const P: string[length(CBlueWindow)+ length(CMenuView)]
  249.          = CBlueWindow + CMenuView;
  250.   begin
  251.   GetPalette := @P;
  252.   end;
  253.  
  254.  
  255.  
  256. procedure TEventWindow.InsertCommand( ACommand: word; ADescription: string);
  257.   var P: PCommandRec;
  258.   begin
  259.   new(P);
  260.   P^.Command := ACommand;
  261.   P^.Description := ADescription;
  262.   CommandList.Insert(P);
  263.   end;
  264.  
  265.  
  266.  
  267. procedure TEventWindow.HandleEvent(var Event: TEvent);
  268.   begin
  269.   TWindow.HandleEvent(Event);
  270.   if Event.What = evCommand then
  271.     begin
  272.     case Event.Command of
  273.       cmEventFilters: FiltersDialog;
  274.       end;
  275.     end;
  276.   end;
  277.  
  278.  
  279.  
  280. procedure TEventWindow.MakeInterior( Maxlines: integer);
  281.   var R: TRect;
  282.       M: PMenubar;
  283.  
  284.   begin
  285.   GetExtent(R);
  286.   R.Grow(-1,-1);
  287.   R.B.Y:= R.A.Y+1;
  288.   M:= new(PEWMenubar, Init(R, NewMenu( NewSubMenu('~O~ptions',hcNoContext, NewMenu(
  289.                  NewItem('~F~ilters','',0,cmEventFilters,hcNoContext,nil)),nil))));
  290.  
  291.   Insert(M);
  292.  
  293.   GetExtent(R);
  294.   R.Grow(-1,-1);
  295.   inc(R.A.Y);
  296.   Interior := new(PTextInterior, Init(R, MaxLines,
  297.                                       StandardScrollBar(sbHorizontal+sbHandleKeyboard),
  298.                                       StandardScrollBar(sbVertical+sbHandleKeyboard)));
  299.   Insert( Interior );
  300.   end;
  301.  
  302.  
  303.  
  304.  
  305. procedure TEventWindow.FiltersDialog;
  306.   var P: PView;
  307.       D: PDialog;
  308.       R: TRect;
  309.       Result: word;
  310.       DataRec: word;
  311.   begin
  312.   R.Assign(10,6,40,20);
  313.   D := new(PDialog, Init(R, 'Message Filters'));
  314.  
  315.   R.Assign(7,2,22,10);
  316.   P := new(PCheckBoxes, Init(R,
  317.          NewSItem('Mouse ~D~own',
  318.          NewSItem('Mouse ~U~p',
  319.          NewSItem('Mouse ~M~ove',
  320.          NewSItem('Mouse ~A~uto',
  321.          NewSItem('~K~eyboard',
  322.          NewSItem('~C~ommand',
  323.          NewSItem('~B~roadcast',
  324.          NewSItem('~O~ther', nil))))))))));
  325.   D^.Insert(P);
  326.  
  327.   R.Assign(5,11,13,13);
  328.   P := new(PButton, Init(R, 'Ok', cmOk, bfDefault));
  329.   D^.Insert(P);
  330.  
  331.   R.Assign(14,11,24,13);
  332.   P := new(PButton, Init(R, 'Cancel', cmCancel, bfNormal));
  333.   D^.Insert(P);
  334.  
  335.   D^.SelectNext(false);
  336.  
  337.   { transfer data from filters to a more linear datarec }
  338.   DataRec := 0;
  339.   DataRec := Filters and (evMouse or evKeyDown);
  340.   DataRec := DataRec or ((Filters - DataRec) shr 3);
  341.  
  342.   D^.SetData(DataRec);
  343.  
  344.   Result := Owner^.ExecView(D);
  345.  
  346.   if Result <> cmCancel then
  347.     begin
  348.     D^.GetData(DataRec);
  349.     Filters := 0;
  350.     Filters := DataRec and (evMouse or evKeyDown);
  351.     Filters := Filters or ((DataRec - Filters) shl 3);
  352.     end;
  353.  
  354.   Dispose(D, Done);
  355.   end;
  356.  
  357.  
  358.  
  359.  
  360. function Message( Receiver: PView; What, Command: word; InfoPtr: Pointer): pointer;
  361.   var E: TEvent;
  362.   begin
  363.   E.What:=what;
  364.   E.Command:=command;
  365.   E.Infoptr:=Infoptr;
  366.  
  367.   if (EventWindow <> nil) then
  368.     EventWindow^.DisplayEvent(E);
  369.  
  370.   { pass the intercepted data on to the Message function it was intended for }
  371.   Message:= Views.Message( Receiver, What, Command, InfoPtr);
  372.   end;
  373.  
  374.  
  375. end.
  376.